﻿'
' Boogaloo® - http://www.mindfly.com
' Copyright (c) 2008
' by Mindfly, Inc.
'
' Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated 
' documentation files (the "Software"), to deal in the Software without restriction, including without limitation 
' the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and 
' to permit persons to whom the Software is furnished to do so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in all copies or substantial portions 
' of the Software.
'
' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
' INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
' DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
' SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
' SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
' WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
' THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Imports System.Web
Imports System.Text
Imports System.Xml

Imports System.IO

Namespace XmlRpc

    Public Class XmlRpcResponse
        Inherits XmlRpcBase


        Public Sub New(ByVal respXml As String)
            Dim context As HttpContext = HttpContext.Current

            ' validate the rpc call against the schema (xsd)
            Dim settings As New XmlReaderSettings
            Dim path As String = context.Server.MapPath("~/App_Data/xml-rpc.xsd")
            settings.Schemas.Add("", path)
            settings.ValidationType = ValidationType.Schema

            Dim responseDoc As New XmlDocument

            Try
                Dim reader As XmlReader = XmlReader.Create(New StringReader(respXml), settings)
                responseDoc.Load(reader)


                With responseDoc.DocumentElement

                    If .FirstChild.LocalName = "params" Then

                        ' there can only be one param in the response
                        Me.param = New XmlRpcValue(.SelectSingleNode("//params/param/value").FirstChild)

                    ElseIf .FirstChild.LocalName = "fault" Then

                        Me.Fault = True

                        Me.param = New XmlRpcValue(.SelectSingleNode("//fault/value").FirstChild)

                    End If

                End With

            Catch ex As Exception

                Throw New XmlRpcException("01", String.Format("Invalid XMLRPC Response. ({0})", ex.Message))

            End Try
        End Sub


        ''' <summary>
        ''' Writes the xml-rpc response to the Response.OutputStream (text/xml)
        ''' </summary>
        Public Overloads Shared Sub Write(ByVal context As HttpContext, ByVal resp As XmlRpcValue, Optional ByVal IncludeTypeElement As Boolean = True)
            context.Response.ContentType = "text/xml"
            Using writer As New StreamWriter(context.Response.OutputStream, System.Text.Encoding.UTF8)
                writer.Write(ToXmlSTring(resp, IncludeTypeElement))
            End Using
        End Sub

        ''' <summary>
        ''' Writes the xml-rpc response fault to the Response.OutputStream (text/xml)
        ''' </summary>
        Public Overloads Shared Sub Write(ByVal context As HttpContext, ByVal fault As XmlRpcFault)
            context.Response.ContentType = "text/xml"
            Using writer As New StreamWriter(context.Response.OutputStream, System.Text.Encoding.UTF8)
                writer.Write(ToXmlSTring(fault))
            End Using
        End Sub

        ''' <summary>
        ''' Creates the xml-rpc response and returns it as a string
        ''' </summary>
        Public Overloads Shared Function ToXmlSTring(ByVal value As XmlRpcValue, Optional ByVal IncludeTypeElement As Boolean = True) As String
            Return String.Format("<methodResponse><params><param><value>{0}</value></param></params></methodResponse>", value.ToXmlString(IncludeTypeElement))
        End Function

        ''' <summary>
        ''' Creates the xml-rpc response fault and returns it as a string
        ''' </summary>
        Public Overloads Shared Function ToXmlString(ByVal rpcFault As XmlRpcFault) As String
            Return String.Format("<methodResponse><fault><value><struct><member><name>faultCode</name><value><int>{0}</int></value></member><member><name>faultString</name><value><string>{1}</string></value></member></struct></value></fault></methodResponse>", rpcFault.faultCode, HttpContext.Current.Server.HtmlEncode(rpcFault.message))
        End Function


        Public Overloads Function ToXmlString(Optional ByVal IncludeTypeElements As Boolean = True) As String

            Dim sb As New StringBuilder
            sb.Append("<methodResponse>")

            If Not Fault Then
                sb.Append(String.Format("<params><param><value>{0}</value></param></params>", param.ToXmlString(IncludeTypeElements)))
            Else
                sb.Append(String.Format("<fault><value>{0}</value></fault>", param.ToXmlString(IncludeTypeElements)))
            End If

            sb.Append("</methodResponse>")

            Return sb.ToString
        End Function

#Region "Properties"



        Private _fault As Boolean
        Public Property Fault() As Boolean
            Get
                Return _fault
            End Get
            Set(ByVal value As Boolean)
                _fault = value
            End Set
        End Property


        Private _param As XmlRpcValue
        Public Property param() As XmlRpcValue
            Get
                Return _param
            End Get
            Set(ByVal value As XmlRpcValue)
                _param = value
            End Set
        End Property


#End Region

    End Class

End Namespace